home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Gold Collection / Software Vault - The Gold Collection (American Databankers) (1993).ISO / cdr36 / lod370e.zip / PROGRAMR.ZIP / MISCO4.PAS < prev    next >
Pascal/Delphi Source File  |  1993-02-19  |  22KB  |  967 lines
  1. unit misco4;
  2. {$O+,F+,V-,I+}
  3.  
  4. interface
  5. uses dos, crt,
  6.  
  7.  {$IFDEF EGA}
  8.  gtvideo,
  9.  {$ENDIF}
  10.  
  11.  ddlod, gtscott, globals, misc, emsalloc, strio, setgen;
  12.  
  13. procedure ReadObjs;
  14. procedure WriteObjs;
  15. procedure OpenFiles;
  16. procedure WriteBases;
  17. procedure WritePuritron;
  18. procedure WriteCasinoStats;
  19. procedure WriteDayStats;
  20. procedure WriteTeams;
  21.  
  22. implementation
  23.  
  24. procedure bwrite(s: string);
  25. begin;
  26.  swrite(#13+' ■ ');
  27.  while length(s)<70 do s:=s+' ';
  28.  swrite(s);
  29. end;
  30.  
  31. procedure Error(s: string);
  32. begin;
  33.  {$IFDEF EGA}
  34.   gtextcolor(15);
  35.   gwriteln('');
  36.   gwriteln(s);
  37.  {$ELSE}
  38.   textcolor(15);
  39.   writeln;
  40.   writeln(s);
  41.  {$ENDIF}
  42.  delay(5000);
  43.  halt;
  44. end;
  45.  
  46. procedure ReadObjs;
  47. const
  48.  numtoread=50;
  49. type
  50.  devarray=array[1..numtoread] of devicetype;
  51.  daptr=^devarray;
  52. var
  53.  o: daptr;
  54.  a: integer;
  55.  objfile: file;
  56.  numread: word;
  57. begin;
  58.  assign(objfile,'OBJECTS.DAT');
  59.  reset(objfile,1);
  60.  if filesize(objfile) mod sizeof(devicetype) <>0 then
  61.   error('Error - OBJECTS.DAT is corrupted!');
  62.  
  63.  close(objfile);
  64.  reset(objfile,sizeof(devicetype));
  65.  
  66.  new(o);
  67.  blockread(objfile,o^,1);
  68.  numolist:=0;
  69.  numread:=numtoread;
  70.  while (numread=numtoread) do begin;
  71.   blockread(objfile,o^,numtoread,numread);
  72.   for a:=1 to numread do if (o^[a].num<>0) and (numolist<numobj) then begin;
  73.    inc(numolist);
  74.    new(objects[numolist]);
  75.    objects[numolist]^:=o^[a];
  76.   end;
  77.  end;
  78.  close(objfile);
  79.  dispose(o);
  80. end;
  81.  
  82. procedure WriteObjs;
  83. var
  84.  o: devicetype;
  85.  a,b: integer;
  86.  objfile: file of devicetype;
  87. begin;
  88.  assign(objfile,'OBJECTS.DAT');
  89.  rewrite(objfile);
  90.  fillchar(o,sizeof(o),0);
  91.  b:=0;
  92.  write(objfile,o);
  93.  for a:=1 to numolist do if objects[a]<>nil then begin;
  94.   inc(b);
  95.   write(objfile,objects[a]^);
  96.  end;
  97.  close(objfile);
  98. end;
  99.  
  100. procedure blankbases;
  101. var
  102.  a: integer;
  103. begin;
  104.  fillchar(bases^,sizeof(bases^),0);
  105.  for a:=1 to numbase do bases^[a].active:=false;
  106. end;
  107.  
  108. procedure LoadStringDef;
  109. type
  110.  buftype=array[1..4096] of byte;
  111.  bufptr=^buftype;
  112.  indextype=array[0..4096] of word;
  113.  indexptr=^indextype;
  114. var
  115.  buffer: bufptr;
  116.  stn: word;
  117.  index: indexptr;
  118.  numindex: word;
  119.  a: integer;
  120.  b: longint;
  121.  idxsize,bufsize,fsize: longint;
  122.  strdefidp: idarrayptr;
  123.  
  124.  m: longint;
  125.  ch1,ch2: char;
  126.  s: string;
  127.  posit,strdsize,stroffset: longint;
  128.  bread: integer;
  129.  
  130.  f2: file;
  131.  f3: text;
  132. begin;
  133.  bwrite('Loading String Definitions');
  134.  seek(gamebin,0);
  135.  blockread(gamebin,s,8);
  136.  s[0]:=#7;
  137.  val(s,stroffset,a);
  138.  seek(gamebin,50);
  139.  blockread(gamebin,s[1],7);
  140.  s[0]:=#7;
  141.  val(s,strdsize,a);
  142.  seek(gamebin,stroffset);
  143.  blockread(gamebin,ch1,1);
  144.  blockread(gamebin,ch2,1);
  145.  
  146.  blockread(gamebin,numindex,2);
  147.  fsize:=filesize(gamebin);
  148.  idxsize:=(numindex+1)*2;
  149.  getmem(index,idxsize);
  150.  blockread(gamebin,index^,idxsize);
  151.  
  152. { eaalloc(strdefid,(numindex+1)*sizeof(idrec));
  153.  strdefidp:=eaaddr(strdefid);
  154.  ealockvar(strdefid);}
  155.  getmem(strdefid,(numindex+1)*sizeof(idrec)); strdefidp:=strdefid;
  156.  
  157.  b:=idxsize+4+stroffset;
  158.  for a:=0 to numindex do begin;
  159.   if index^[a]=0 then begin;
  160.    strdefidp^[a].poshi:=0;
  161.    strdefidp^[a].poslo:=0;
  162.   end else if (index^[a] and 32768)<>0 then begin;
  163.    stn:=index^[a] and 32767;
  164.    strdefidp^[a].poshi:=strdefidp^[stn].poshi;
  165.    strdefidp^[a].poslo:=strdefidp^[stn].poslo;
  166.   end else begin;
  167.    strdefidp^[a].poshi:=(b div 65536);
  168.    strdefidp^[a].poslo:=(b and 65535);
  169.    b:=b+index^[a];
  170.   end;
  171.  end;
  172.  
  173. { eaunlockvar(strdefid);}
  174.  
  175.  freemem(index,idxsize);
  176.  
  177. { bwrite('Extracting stringdef information');
  178.  new(buffer);
  179.  assign(f2,'TEMPSTR$.$$$');
  180.  rewrite(f2,1);
  181.  seek(f,longint(idxsize)+4+stroffset);
  182.  bread:=sizeof(buffer^);
  183.  posit:=longint(idxsize)+4+stroffset;
  184.  while (bread=sizeof(buffer^)) and (posit<=strdsize+stroffset+1024) do begin;
  185.   blockread(f,buffer^,sizeof(buffer^),bread);
  186.   blockwrite(f2,buffer^,bread);
  187.   posit:=posit+bread;
  188.  end;
  189.  close(f2);
  190.  dispose(buffer);}
  191.  
  192.  m:=memavail;
  193.  openstringcache;
  194.  m:=m-memavail;
  195.  strdefbytes:=m+(numindex+1)*sizeof(idrec);
  196.  numstrdef:=numindex;
  197. end;
  198.  
  199. procedure AddTeleCode(d: word; x,y: word);
  200. var
  201.  a,b,c: integer;
  202.  c1,c2,c3: integer;
  203.  bad: boolean;
  204.  count: word;
  205. begin;
  206.  c1:=(x mod 3)+1;
  207.  c2:=(y mod 3)+1;
  208.  c3:=((x+y) mod 3)+1;
  209.  
  210.  c:=0;
  211.  for a:=1 to numtcode do if (telecodes[a].d=0) and (c=0) then c:=a;
  212.  if c=0 then exit;
  213.  
  214.  count:=1;
  215.  repeat;
  216.   bad:=false;
  217.   for a:=1 to numtcode do if (telecodes[a].c[1]=c1) and (telecodes[a].c[2]=c2) and (telecodes[a].c[3]=c3) then bad:=true;
  218.   if bad then begin;
  219.    inc(c3);
  220.    if c3>3 then begin;
  221.     c3:=1;
  222.     inc(c2);
  223.     if c2>3 then begin;
  224.      c2:=1;
  225.      inc(c1);
  226.      if c1>1 then c1:=1;
  227.     end;
  228.    end;
  229.   end;
  230.   inc(count);
  231.  until (not bad) or (count=100);
  232.  
  233.  if not bad then begin;
  234.   telecodes[c].c[1]:=c1;
  235.   telecodes[c].c[2]:=c2;
  236.   telecodes[c].c[3]:=c3;
  237.   telecodes[c].x:=x;
  238.   telecodes[c].y:=y;
  239.   telecodes[c].z:=1;
  240.   telecodes[c].d:=d;
  241.  end;
  242. end;
  243.  
  244. procedure maketelecodes;
  245. var
  246.  z,x,y: word;
  247. begin;
  248.  fillchar(telecodes,sizeof(telecodes),0);
  249.  for z:=1 to maxmapz do for x:=1 to maxmapx do for y:=1 to maxmapy do if getmap(z,x,y) in [9,10] then begin;
  250.   AddTeleCode(1,x,y);
  251.  end;
  252.  AddTeleCode(2,3,4);
  253.  AddTeleCode(3,5,6);
  254. end;
  255.  
  256. procedure SqrIt(var n: word);
  257. begin;
  258.  n:=n*n;
  259. end;
  260.  
  261. procedure loaddevdef;
  262. var
  263.  devs: devdeftype;
  264.  a,b: word;
  265.  numread: word;
  266.  devofs,devsize: longint;
  267.  s: string;
  268.  junk: integer;
  269. begin;
  270.  seek(gamebin,22);
  271.  blockread(gamebin,s[1],7);
  272.  s[0]:=#7;
  273.  val(s,devofs,junk);
  274.  seek(gamebin,43);
  275.  blockread(gamebin,s[1],7);
  276.  s[0]:=#7;
  277.  val(s,devsize,junk);
  278.  if (devsize mod sizeof(devdeftype))<>0 then error('Error - Fubar in dev def');
  279.  devgood:=0;
  280.  devfill:=0;
  281.  devnil:=0;
  282.  b:=0;
  283.  seek(gamebin,devofs);
  284.  for a:=1 to devsize div sizeof(devdeftype) do begin;
  285.   blockread(gamebin,devs,sizeof(devdeftype));
  286.   if (b<=numdev) then begin;
  287.    if (b<>0) and (stu(devs.name)='NIL') and (devs.store=[]) and (ord(devs.devapp)=0) then begin;
  288.     inc(devnil);
  289.     devicedef[b]:=devicedef[0];
  290.    end else begin;
  291.     getmem(devicedef[b],sizeof(devdeftype));
  292.     devicedef[b]^:=devs;
  293.     devicedef[b]^.num:=b;
  294.     inc(devgood);
  295.    end;
  296.    inc(b);
  297.   end;
  298.  end;
  299.  
  300.  if b<numdev then for a:=b to numdev do begin;
  301.   devicedef[a]:=devicedef[0];
  302.   inc(devfill);
  303.  end;
  304. end;
  305.  
  306. procedure loaddevdefs;
  307. begin;
  308.  bwrite('Loading device definitions');
  309.  devgood:=0;
  310.  devfill:=0;
  311.  devnil:=0;
  312.  loaddevdef;
  313. end;
  314.  
  315. procedure LoadGameDef;
  316. var
  317.  gddone: boolean;
  318.  linepos: word;
  319.  donemonster: boolean;
  320.  donecombat: boolean;
  321.  donetalk: boolean;
  322.  donetroy: boolean;
  323.  donetrell: boolean;
  324.  donehist: boolean;
  325.  donetavern: boolean;
  326.  donemisc: boolean;
  327.  s: string;
  328.  ofm: word;
  329.  
  330. procedure loadmisc;
  331. var
  332.  s,s2,s3,s4: string;
  333.  done: boolean;
  334.  a,n: integer;
  335. begin;
  336.  bwrite('Loading data set information');
  337.  fillchar(dataset,sizeof(dataset),0);
  338.  done:=false;
  339.  n:=0;
  340.  while (not eof(gamedef)) and (not done) do begin;
  341.   inc(linepos);
  342.   readln(gamedef,s);
  343.   if s='&&&END' then begin;
  344.    done:=true;
  345.   end else begin;
  346.    inc(n);
  347.    case n of
  348.     1: dataset.name:=newstr(s);
  349.     2: dataset.author:=newstr(s);
  350.     3: dataset.menustem:=s;
  351.     4: val(s,dataset.sdstart,a);
  352.     5: val(s,dataset.sdend,a);
  353.     6: dataset.prodname[1]:=newstr(s);
  354.     7: dataset.prodname[2]:=newstr(s);
  355.     8: dataset.prodname[3]:=newstr(s);
  356.     9..18: dataset.cityname[n-8]:=newstr(s);
  357.     19: dataset.hisstr:=newstr(s);
  358.     20: dataset.herstr:=newstr(s);
  359.     21: dataset.itsstr:=newstr(s);
  360.     22: dataset.hestr:=newstr(s);
  361.     23: dataset.shestr:=newstr(s);
  362.     24: dataset.itstr:=newstr(s);
  363.     25: dataset.mhimstr:=newstr(s);
  364.     26: dataset.fhimstr:=newstr(s);
  365.     27: dataset.ihimstr:=newstr(s);
  366.     28: val(s,dataset.obstart,a);
  367.     29: val(s,dataset.obend,a);
  368.    end;
  369.   end;
  370.  end;
  371.  donemisc:=true;
  372. end;
  373.  
  374. procedure loadmonster;
  375. var
  376.  done: boolean;
  377.  s: string;
  378.  b: integer;
  379. begin;
  380.  bwrite('Indexing monsters');
  381.  nummondef:=0;
  382.  done:=false;
  383.  while (not eof(gamedef)) and (nummondef<maxmon) and (not done) do begin;
  384.   inc(linepos);
  385.   readln(gamedef,s);
  386.   if s='&&&END' then begin;
  387.    done:=true;
  388.   end else if pos('NAME',s)=1 then begin;
  389.    inc(nummondef);
  390.    EAAlloc(mondef[nummondef],sizeof(monsterrec));
  391.    fillchar(EAAddr(mondef[nummondef])^,sizeof(monsterrec),0);
  392.    MonsterRec(EAAddr(mondef[nummondef])^).line:=linepos;
  393.    MonsterRec(EAAddr(mondef[nummondef])^).origx:=255;
  394.    MonsterRec(EAAddr(mondef[nummondef])^).origy:=255;
  395.    MonsterRec(EAAddr(mondef[nummondef])^).origz:=255;
  396.    MonsterRec(EAAddr(mondef[nummondef])^).mindist:=0;
  397.    MonsterRec(EAAddr(mondef[nummondef])^).maxdist:=100;
  398.   end else if (pos('MINDIST',s)=1) and (nummondef>0) then begin;
  399.    delete(s,1,8);
  400.    val(s,MonsterRec(EAAddr(mondef[nummondef])^).mindist,b);
  401.    sqrit(MonsterRec(EAAddr(mondef[nummondef])^).mindist);
  402.   end else if (pos('MAXDIST',s)=1) and (nummondef>0) then begin;
  403.    delete(s,1,8);
  404.    val(s,MonsterRec(EAAddr(mondef[nummondef])^).maxdist,b);
  405.    sqrit(MonsterRec(EAAddr(mondef[nummondef])^).maxdist);
  406.   end else if (pos('ORIGX',s)=1) and (nummondef>0) then begin;
  407.    delete(s,1,6);
  408.    val(s,MonsterRec(EAAddr(mondef[nummondef])^).origx,b);
  409.   end else if (pos('ORIGY',s)=1) and (nummondef>0) then begin;
  410.    delete(s,1,6);
  411.    val(s,MonsterRec(EAAddr(mondef[nummondef])^).origy,b);
  412.   end else if (pos('ORIGZ',s)=1) and (nummondef>0) then begin;
  413.    delete(s,1,6);
  414.    val(s,MonsterRec(EAAddr(mondef[nummondef])^).origz,b);
  415.   end else if (pos('STR',s)=1) and (nummondef>0) then begin;
  416.    delete(s,1,4);
  417.    val(s,MonsterRec(EAAddr(mondef[nummondef])^).str,b);
  418.   end else if (pos('DEX',s)=1) and (nummondef>0) then begin;
  419.    delete(s,1,4);
  420.    val(s,MonsterRec(EAAddr(mondef[nummondef])^).dex,b);
  421.   end else if (pos('AGL',s)=1) and (nummondef>0) then begin;
  422.    delete(s,1,4);
  423.    val(s,MonsterRec(EAAddr(mondef[nummondef])^).agl,b);
  424.   end else if (pos('IFALIVE',s)=1) and (nummondef>0) then begin;
  425.    delete(s,1,8);
  426.    val(s,MonsterRec(EAAddr(mondef[nummondef])^).ifalive,b);
  427.   end else if (pos('ISREAL',s)=1) and (nummondef>0) then begin;
  428.    MonsterRec(EAAddr(mondef[nummondef])^).flags:=MonsterRec(EAAddr(mondef[nummondef])^).flags or flagmonisreal;
  429.   end;
  430.  end;
  431.  donemonster:=true;
  432. end;
  433.  
  434. procedure loadtalk;
  435. var
  436.  a: word;
  437.  done: boolean;
  438.  s: string;
  439. begin;
  440.  bwrite('Processing dialog');
  441.  talkstart:=linepos;
  442.  done:=false;
  443.  while (not eof(gamedef)) and (not done) do begin;
  444.   inc(linepos);
  445.   readln(gamedef,s);
  446.   if s='&&&END' then begin;
  447.    done:=true;
  448.   end;
  449.  end;
  450.  donetalk:=true;
  451. end;
  452.  
  453. procedure LoadCstr;
  454. var
  455.  f: text;
  456.  s: string;
  457.  s2,s3,s4: string[80];
  458.  a,b: integer;
  459.  done: boolean;
  460. begin;
  461.  bwrite('Loading combat string tables');
  462.  done:=false;
  463.  numgroups:=0;
  464.  while (not eof(gamedef)) and (not done) do begin;
  465.   inc(linepos);
  466.   readln(gamedef,s);
  467.   if s='&&&END' then begin;
  468.    done:=true;
  469.   end else if stu(s)='NEWGROUP' then begin;
  470.    inc(numgroups);
  471.    new(groups[numgroups]);
  472.    fillchar(groups[numgroups]^,sizeof(groups[numgroups]^),0);
  473.   end else if (pos('INCLUDE',stu(s))=1) and (numgroups>0) then begin;
  474.    if groups[numgroups]^.numinclude<maxinclude then begin;
  475.     delete(s,1,8);
  476.     s2:='';
  477.     s3:='';
  478.     s4:='';
  479.     inc(groups[numgroups]^.numinclude);
  480.     while (s[1]<>' ') and (length(s)>0) do begin;
  481.      s2:=s2+s[1];
  482.      delete(s,1,1);
  483.     end;
  484.     while (s[1]=' ') and (length(s)>0) do delete(s,1,1);
  485.     while (s[1]<>' ') and (length(s)>0) do begin;
  486.      s3:=s3+s[1];
  487.      delete(s,1,1);
  488.     end;
  489.     while (s[1]=' ') and (length(s)>0) do delete(s,1,1);
  490.     while (s[1]<>' ') and (length(s)>0) do begin;
  491.      s4:=s4+s[1];
  492.      delete(s,1,1);
  493.     end;
  494.     while (s[1]=' ') and (length(s)>0) do delete(s,1,1);
  495.     groups[numgroups]^.include[groups[numgroups]^.numinclude].code:=s2;
  496.     val(s3,a,b);
  497.     groups[numgroups]^.include[groups[numgroups]^.numinclude].guy1:=a;
  498.     val(s4,a,b);
  499.     groups[numgroups]^.include[groups[numgroups]^.numinclude].guy2:=a;
  500.    end;
  501.   end else if (numgroups>0) and (s<>'') and (s[1]<>';') then begin;
  502.    inc(groups[numgroups]^.numstr);
  503.    val(s,groups[numgroups]^.strings[groups[numgroups]^.numstr],a);
  504.   end;
  505.  end;
  506.  donecombat:=true;
  507. end;
  508.  
  509. procedure loadtroy;
  510. var
  511.  a: word;
  512.  s: string;
  513. begin;
  514.  if eof(gamedef) then exit;
  515.  inc(linepos);
  516.  readln(gamedef,s);
  517.  val(s,troystart,a);
  518.  if eof(gamedef) then exit;
  519.  inc(linepos);
  520.  readln(gamedef,s);
  521.  val(s,troyend,a);
  522.  if eof(gamedef) then exit;
  523.  inc(linepos);
  524.  readln(gamedef,s);
  525.  if s<>'&&&END' then exit;
  526.  donetroy:=true;
  527. end;
  528.  
  529. procedure loadtrell;
  530. var
  531.  a: word;
  532.  s: string;
  533. begin;
  534.  
  535.  if eof(gamedef) then exit;
  536.  inc(linepos);
  537.  readln(gamedef,s);
  538.  val(s,trellstart,a);
  539.  if eof(gamedef) then exit;
  540.  inc(linepos);
  541.  readln(gamedef,s);
  542.  val(s,trellend,a);
  543.  if eof(gamedef) then exit;
  544.  inc(linepos);
  545.  readln(gamedef,s);
  546.  if s<>'&&&END' then exit;
  547.  donetrell:=true;
  548. end;
  549.  
  550. procedure loadhist;
  551. var
  552.  a: word;
  553.  s: string;
  554. begin;
  555.  if eof(gamedef) then exit;
  556.  inc(linepos);
  557.  readln(gamedef,s);
  558.  val(s,histstart,a);
  559.  if eof(gamedef) then exit;
  560.  inc(linepos);
  561.  readln(gamedef,s);
  562.  val(s,histend,a);
  563.  if eof(gamedef) then exit;
  564.  inc(linepos);
  565.  readln(gamedef,s);
  566.  if s<>'&&&END' then exit;
  567.  donehist:=true;
  568. end;
  569.  
  570. procedure loadtavern;
  571. var
  572.  a: word;
  573.  done: boolean;
  574.  s,s2: string;
  575.  n1,n2: word;
  576. begin;
  577.  bwrite('Loading tavern data');
  578.  numtav:=0;
  579.  done:=false;
  580.  while (not eof(gamedef)) and (not done) do begin;
  581.   inc(linepos);
  582.   readln(gamedef,s);
  583.   if s='&&&END' then begin;
  584.    done:=true;
  585.   end else begin;
  586.    while (s<>'') and (s[1]=' ') do delete(s,1,1);
  587.    s2:='';
  588.    while (s<>'') and (s[1]<>' ') do begin;
  589.     s2:=s2+s[1];
  590.     delete(s,1,1);
  591.    end;
  592.    val(s2,n1,a);
  593.    while (s<>'') and (s[1]=' ') do delete(s,1,1);
  594.    s2:='';
  595.    while (s<>'') and (s[1]<>' ') do begin;
  596.     s2:=s2+s[1];
  597.     delete(s,1,1);
  598.    end;
  599.    val(s2,n2,a);
  600.    while (s<>'') and (s[1]=' ') do delete(s,1,1);
  601.    if (s<>'') and (n1<>0) and (n2<>0) and (numtav<maxtav) then begin;
  602.     inc(numtav);
  603.     new(tavern[numtav]);
  604.     tavern[numtav]^.personnum:=n2;
  605.     tavern[numtav]^.townnum:=n1;
  606.     tavern[numtav]^.personname:=s;
  607.    end;
  608.   end;
  609.  end;
  610.  donetavern:=true;
  611. end;
  612.  
  613. begin;
  614.  donemonster:=false;
  615.  donecombat:=false;
  616.  donetalk:=false;
  617.  donetrell:=false;
  618.  donetroy:=false;
  619.  donehist:=false;
  620.  donetavern:=false;
  621.  donemisc:=false;
  622.  linepos:=0;
  623.  gddone:=false;
  624.  while (not eof(gamedef)) and (not gddone) do begin;
  625.   inc(linepos);
  626.   readln(gamedef,s);
  627.   while (s[1]=' ') and (s<>'') do delete(s,1,1);
  628.   while s[length(s)]=' ' do dec(s[0]);
  629.   if (s<>'') and (s[1]<>';') then begin;
  630.    if s='&&&MONSTER' then loadmonster;
  631.    if s='&&&TALK' then loadtalk;
  632.    if s='&&&COMBAT' then loadcstr;
  633.    if s='&&&TROYINFO' then loadtroy;
  634.    if s='&&&TRELLNOT' then loadtrell;
  635.    if s='&&&HISTORY' then loadhist;
  636.    if s='&&&TAVERN' then loadtavern;
  637.    if s='&&&MISC' then loadmisc;
  638.    if s='&&&DONE' then gddone:=true;
  639.   end;
  640.  end;
  641.  if not donemonster then error('Error - could not load monster info from GAME.DEF.');
  642.  if not donecombat then  error('Error - could not load combat info from GAME.DEF.');
  643.  if not donetalk then    error('Error - could not load talk info from GAME.DEF.');
  644.  if not donetroy then    error('Error - could not load troyinfo info from GAME.DEF.');
  645.  if not donetrell then   error('Error - could not load trellnot info from GAME.DEF.');
  646.  if not donehist then    error('Error - could not load history info from GAME.DEF.');
  647.  if not donetavern then  error('Error - could not load tavern info from GAME.DEF.');
  648.  if not donemisc then    error('Error - could not load dataset info from GAME.DEF.');
  649. end;
  650.  
  651. procedure opengamedef;
  652. var
  653.  ofm: word;
  654.  buf: array[1..1024] of byte;
  655.  bread: word;
  656.  f2: file;
  657. begin;
  658.  bwrite('Reading Master Game Definition');
  659.  assign(gamebin,'GAME.DEF');
  660.  reset(gamebin,1);
  661.  assign(gamedef,'GAME.DEF');
  662.  {$I-}
  663.  reset(gamedef);
  664.  {$I+}
  665.  if ioresult<>0 then begin;
  666.   bwrite('Data access fault: Duplicating GAME.DEF');
  667.   assign(f2,'GAME.DE2');
  668.   rewrite(f2,1);
  669.   bread:=1024;
  670.   while (bread=1024) do begin;
  671.    blockread(gamebin,buf,1024,bread);
  672.    blockwrite(f2,buf,bread);
  673.   end;
  674.   close(f2);
  675.   assign(gamedef,'GAME.DE2');
  676.   reset(gamedef);
  677.  end;
  678. end;
  679.  
  680. procedure fixmonsters;
  681. var
  682.  cz,cx,cy: byte;
  683.  a: integer;
  684. begin;
  685.  findcity(1,cz,cx,cy);
  686.  for a:=1 to nummondef do if MonsterRec(EAAddr(mondef[a])^).origz=255 then begin;
  687.   MonsterRec(EAAddr(mondef[a])^).origz:=cz;
  688.   MonsterRec(EAAddr(mondef[a])^).origx:=cx;
  689.   MonsterRec(EAAddr(mondef[a])^).origy:=cy;
  690.  end;
  691. end;
  692.  
  693. procedure loadmap(n: word);
  694. var
  695.  a: integer;
  696.  s: string[10];
  697.  mapofs: longint;
  698. begin;
  699.  seek(gamebin,8);
  700.  blockread(gamebin,s[1],7);
  701.  s[0]:=#7;
  702.  val(s,mapofs,a);
  703.  seek(gamebin,mapofs);
  704.  blockread(gamebin,zmap^,sizeof(zmap^));
  705. end;
  706.  
  707. procedure loadterrain;
  708. var
  709.  a: integer;
  710.  s: string[10];
  711.  mapofs: longint;
  712. begin;
  713.  bwrite('Loading terrain definitions');
  714.  seek(gamebin,15);
  715.  blockread(gamebin,s[1],7);
  716.  s[0]:=#7;
  717.  val(s,mapofs,a);
  718.  seek(gamebin,mapofs);
  719.  blockread(gamebin,terrain,sizeof(terrain));
  720. end;
  721.  
  722. procedure loadgeneral;
  723. var
  724.  a: integer;
  725.  s: string[10];
  726.  fsize, mapofs: longint;
  727.  bread: word;
  728. begin;
  729.  bwrite('Loading general data');
  730.  
  731.  seek(gamebin,29);
  732.  blockread(gamebin,s[1],7);
  733.  s[0]:=#7;
  734.  val(s,mapofs,a);
  735.  
  736.  seek(gamebin,36);
  737.  blockread(gamebin,s[1],7);
  738.  s[0]:=#7;
  739.  val(s,fsize,a);
  740.  if fsize>sizeof(general) then fsize:=sizeof(general);
  741.  
  742.  seek(gamebin,mapofs);
  743.  blockread(gamebin,general,fsize,bread);
  744. end;
  745.  
  746. procedure OpenFiles;
  747. var
  748.  a,b: integer;
  749.  u: usertype;
  750.  o: devicetype;
  751.  f: file;
  752.  basfile: file of basearray;
  753.  genfile: file of generaltype;
  754.  objfile: file of devicetype;
  755.  dayfile: file;
  756.  teafile: file;
  757.  pfile: file;
  758.  s: string[80];
  759.  cz,cx,cy: byte;
  760.  uidx: file of useridxarray;
  761.  clone: clonetype;
  762.  cfile: file;
  763. begin;
  764.  setgeneral;
  765.  opengamedef;
  766.  loadgeneral;
  767.  loadgamedef;
  768.  loadterrain;
  769.  loadmap(1);
  770.  loaddevdefs;
  771.  
  772.  assign(userfile,'USERS.DAT');
  773.  {$I-}
  774.  reset(userfile);
  775.  {$I+}
  776.  if ioresult<>0 then begin;
  777.   rewrite(userfile);
  778.   blankuser(u);
  779.   u.x:=0;
  780.   u.y:=0;
  781.   u.z:=0;
  782.   for a:=0 to 255 do write(userfile,u);
  783.   reset(userfile);
  784.  end;
  785.  
  786.  bwrite('Reading Objects');
  787.  if not exist('OBJECTS.DAT') then begin;
  788.   assign(objfile,'OBJECTS.DAT');
  789.   rewrite(objfile);
  790.   fillchar(o,sizeof(o),0);
  791.   write(objfile,o);
  792.   close(objfile);
  793.  end;
  794.  readobjs;
  795.  
  796.  bwrite('Reading Fortresses');
  797.  assign(basfile,'BASES.DAT');
  798.  {$I-}
  799.  reset(basfile);
  800.  {$I+}
  801.  if ioresult<>0 then begin;
  802.   BlankBases;
  803.   rewrite(basfile);
  804.   write(basfile,bases^);
  805.   close(basfile);
  806.  end else begin;
  807.   close(basfile);
  808.   assign(f,'BASES.DAT');
  809.   reset(f,1);
  810.   if filesize(f)<>22875 then
  811.    error('Error - BASES.DAT has been corrupted!');
  812.   close(f);
  813.   reset(basfile);
  814.   read(basfile,bases^);
  815.   close(basfile);
  816.  end;
  817.  
  818.  assign(uidx,'USERIDX.DAT');
  819.  {$I-}
  820.  reset(uidx);
  821.  {$I+}
  822.  if ioresult<>0 then begin;
  823.   fillchar(useridx,sizeof(useridx),0);
  824.   rewrite(uidx);
  825.   write(uidx,useridx);
  826.   close(uidx);
  827.  end else begin;
  828.   read(uidx,useridx);
  829.   close(uidx);
  830.  end;
  831.  
  832.  bwrite('Opening Clone File');
  833.  assign(clonefile,'CLONES.DAT');
  834.  {$I-}
  835.  reset(clonefile);
  836.  {$I+}
  837.  if ioresult<>0 then begin;
  838.   fillchar(clone,sizeof(clone),0);
  839.   clone.alive:=false;
  840.   rewrite(clonefile);
  841.   for a:=0 to 255 do write(clonefile,clone);
  842.   reset(clonefile);
  843.  end;
  844.  
  845.  bwrite('Opening Puritron File');
  846.  assign(pfile,'PURITRON.DAT');
  847.  {$I-}
  848.  reset(pfile,1);
  849.  {$I+}
  850.  if ioresult<>0 then begin;
  851.   fillchar(puritron,sizeof(puritron),0);
  852.   for a:=1 to numpurparts do begin;
  853.    puritron.parts[a].ishere:=false;
  854.    puritron.parts[a].reset:=false;
  855.   end;
  856.   rewrite(pfile,1);
  857.   blockwrite(pfile,puritron,sizeof(puritron));
  858.   close(pfile);
  859.  end else begin;
  860.   if filesize(pfile)<>sizeof(puritron) then
  861.    error('Error - Puritron.dat has been corrupted.');
  862.   blockread(pfile,puritron,sizeof(puritron));
  863.   close(pfile);
  864.  end;
  865.  
  866.  bwrite('Opening Casino Stats File');
  867.  assign(cfile,'CASSTATS.DAT');
  868.  {$I-}
  869.  reset(cfile,1);
  870.  {$I+}
  871.  if ioresult<>0 then begin;
  872.   fillchar(EAAddr(casinostats)^,sizeof(casinotype),0);
  873.   rewrite(cfile,1);
  874.   EABlockwrite(cfile,casinostats,sizeof(casinotype));
  875.   close(cfile);
  876.  end else begin;
  877.   if filesize(cfile)<>sizeof(casinotype) then
  878.    error('Error - Casstats.dat has been corrupted.');
  879.   EABlockread(cfile,casinostats,sizeof(casinotype));
  880.   close(cfile);
  881.  end;
  882.  
  883.  bwrite('Opening Day Stats File');
  884.  fillchar(EAAddr(daystats)^,sizeof(daystattype),0);
  885.  assign(dayfile,'DAYSTATS.DAT');
  886.  {$i-}
  887.  reset(dayfile,1);
  888.  {$I+}
  889.  if ioresult=0 then begin;
  890.   if filesize(dayfile)<>sizeof(daystattype) then
  891.    error('Error - Daystats.dat has been corrupted.');
  892.   EABlockread(dayfile,daystats,sizeof(daystattype));
  893.   close(dayfile);
  894.  end;
  895.  
  896.  bwrite('Opening Team File');
  897.  fillchar(EAAddr(teams)^,sizeof(teamarray),0);
  898.  assign(teafile,'TEAMS.DAT');
  899.  {$i-}
  900.  reset(teafile,1);
  901.  {$I+}
  902.  if ioresult=0 then begin;
  903.   if filesize(teafile)<>sizeof(teamarray) then
  904.    error('Error - Teams.Dat has been corrupted.');
  905.   EABlockRead(teafile,teams,sizeof(teamarray));
  906.   close(teafile);
  907.  end;
  908.  
  909.  fixmonsters;
  910.  maketelecodes;
  911.  loadstringdef;
  912.  
  913.  bwrite('Startup completed');
  914.  swriteln('');
  915. end;
  916.  
  917. procedure WriteTeams;
  918. var
  919.  teamfile: file;
  920. begin;
  921.  assign(teamfile,'TEAMS.DAT');
  922.  rewrite(teamfile,1);
  923.  EAblockwrite(teamfile,teams,sizeof(teamarray));
  924.  close(teamfile);
  925. end;
  926.  
  927. procedure WriteDayStats;
  928. var
  929.  dayfile: file;
  930. begin;
  931.  assign(dayfile,'DAYSTATS.DAT');
  932.  rewrite(dayfile,1);
  933.  EAblockwrite(dayfile,daystats,sizeof(daystattype));
  934.  close(dayfile);
  935. end;
  936.  
  937. procedure WriteCasinoStats;
  938. var
  939.  cfile: file;
  940. begin;
  941.  assign(cfile,'CASSTATS.DAT');
  942.  rewrite(cfile,1);
  943.  EaBlockwrite(cfile,casinostats,sizeof(casinotype));
  944.  close(cfile);
  945. end;
  946.  
  947. procedure WritePuritron;
  948. var
  949.  pfile: file;
  950. begin;
  951.  assign(pfile,'PURITRON.DAT');
  952.  rewrite(pfile,1);
  953.  blockwrite(pfile,puritron,sizeof(puritron));
  954.  close(pfile);
  955. end;
  956.  
  957. procedure WriteBases;
  958. var
  959.  basfile: file;
  960. begin;
  961.  assign(basfile,'BASES.DAT');
  962.  reset(basfile,1);
  963.  blockwrite(basfile,bases^,sizeof(bases^));
  964.  close(basfile);
  965. end;
  966.  
  967. end.